perm filename THRESH.SAI[PIC,HE] blob sn#430347 filedate 1979-04-04 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY THRESH,THRM,overlay
C00004 00003	 SIMPLE SIMPLE PROCEDURE MNSNW   ! MASK, NO SHRINK, NO WRAP-AROUND
C00007 00004	 SIMPLE PROCEDURE NMNSNW   ! NO MASK, NO SHRINK, NO WRAP-AROUND
C00009 00005	M←MASKBUF≥0	! MASK? 
C00011 00006	simple internal integer procedure thrm(integer curbuf,masKbuf,val,maskin,series)
C00017 ENDMK
C⊗;
ENTRY THRESH,THRM,overlay;
BEGIN "THRESH"
REQUIRE "BAYSAI.SAI" SOURCE!FILE;
SOURCE!L(UTILS.DCL);
SOURCE!V(PICBUF.DCL);

EXTERNAL INTEGER SIMPLE PROCEDURE CROP(INTEGER BUF,STARTI,ENDI,STARTJ,ENDJ);


INTEGER I,J,ILIM,JLIM,IPTR,OPTR,IINCR,JINCR,MPTR,
		IMIN,JMIN,IMAX,JMAX;
INTERNAL INTEGER PROCEDURE THRESH(INTEGER CURBUF,MASKBUF,UPTHR,LWTHR,BYTZ,SHRINK);
BEGIN "TH"
SIMPLE PROCEDURE MM; BEGIN IF IMIN>0 THEN IMAX←I ELSE IMIN←IMAX←I;
		IF JMIN>J THEN JMIN←J ELSE JMAX←JMAX MAX J; END;
	INTEGER NEWBUF,NEWERBUF;
	BOOLEAN M,S,W;
SIMPLE PROCEDURE IOPTR;
	BEGIN
	IPTR←INPTR(I+IINCR,JINCR+1,CURBUF);
	OPTR←OUTPTR(I,1,NEWBUF);
	END;
SIMPLE PROCEDURE IMOPTR;
	BEGIN
	IOPTR;
	MPTR←INPTR(I,1,MASKBUF);
	END;
 SIMPLE SIMPLE PROCEDURE MNSNW;   ! MASK, NO SHRINK, NO WRAP-AROUND;
	FOR I←1 STEP 1 UNTIL ILIM DO
	    BEGIN
	    IMOPTR;
	    FOR J←1 STEP 1 UNTIL JLIM DO
	      IF ILDB(MPTR) THEN IF LWTHR≤ILDB(IPTR)≤UPTHR THEN IDPB(-1,OPTR)
	            ELSE IBP(OPTR)
	      ELSE BEGIN IBP(IPTR); IBP(OPTR); END;
	    END;


 SIMPLE PROCEDURE MNSW;   ! MASK, NO SHRINK, WRAP-AROUND;
	FOR I←1 STEP 1 UNTIL ILIM DO
	    BEGIN
	    IMOPTR;
	    FOR J←1 STEP 1 UNTIL JLIM DO
	      IF ILDB(MPTR) THEN
		IF ILDB(IPTR)≤UPTHR OR LWTHR≤LDB(IPTR)<361
		THEN IDPB(-1,OPTR) ELSE IBP(OPTR)
		ELSE BEGIN IBP(IPTR); IBP(OPTR); END;
	    END;


 SIMPLE PROCEDURE MSNW;   ! MASK, SHRINK, NO WRAP-AROUND;
	FOR I←1 STEP 1 UNTIL ILIM DO
	    BEGIN
	    IMOPTR;
	    FOR J←1 STEP 1 UNTIL JLIM DO
	      IF ILDB(MPTR) THEN IF LWTHR≤ILDB(IPTR)≤UPTHR THEN 
		BEGIN
		IDPB(-1,OPTR);
		MM;
		END
    	      ELSE IBP(OPTR)
	    ELSE BEGIN IBP(IPTR); IBP(OPTR); END;
	    END;


 SIMPLE PROCEDURE MSW;  ! MASK, SHRINK, WRAP-AROUND;
	FOR I←1 STEP 1 UNTIL ILIM DO
	    BEGIN
	    IMOPTR;
	    FOR J←1 STEP 1 UNTIL JLIM DO
	      IF ILDB(MPTR) THEN
		IF ILDB(IPTR)≤UPTHR OR LWTHR≤LDB(IPTR)<361
		    THEN BEGIN
			IDPB(-1,OPTR);
			MM;
			END
	    ELSE IBP(OPTR)
	    ELSE BEGIN IBP(IPTR); IBP(OPTR); END;
	    END;
 SIMPLE PROCEDURE NMNSNW;   ! NO MASK, NO SHRINK, NO WRAP-AROUND;
	FOR I←1 STEP 1 UNTIL ILIM DO
	    BEGIN
	    IOPTR;
	    FOR J←1 STEP 1 UNTIL JLIM DO
	       IF LWTHR≤ILDB(IPTR)≤UPTHR THEN IDPB(-1,OPTR)
	            ELSE IBP(OPTR);
	    END;


 SIMPLE PROCEDURE NMNSW;   ! NO MASK, NO SHRINK, WRAP-AROUND;
	FOR I←1 STEP 1 UNTIL ILIM DO
	    BEGIN
	    IOPTR;
	    FOR J←1 STEP 1 UNTIL JLIM DO
	      IF ILDB(IPTR)≤UPTHR OR LWTHR≤LDB(IPTR)<361
	      THEN IDPB(-1,OPTR) ELSE IBP(OPTR);
	    END;


 SIMPLE PROCEDURE NMSNW;   ! NO MASK, SHRINK, NO WRAP-AROUND;
	FOR I←1 STEP 1 UNTIL ILIM DO
	    BEGIN
	    IOPTR;
	    FOR J←1 STEP 1 UNTIL JLIM DO
	      IF LWTHR≤ILDB(IPTR)≤UPTHR THEN 
		BEGIN
		IDPB(-1,OPTR);
		MM;
		END
    	      ELSE IBP(OPTR);
	    END;


 SIMPLE PROCEDURE NMSW;  ! NO MASK, SHRINK, WRAP-AROUND;
	FOR I←1 STEP 1 UNTIL ILIM DO
	    BEGIN
	    IOPTR;
	    FOR J←1 STEP 1 UNTIL JLIM DO
		IF ILDB(IPTR)≤UPTHR OR LWTHR≤LDB(IPTR)<361
		    THEN BEGIN
			IDPB(-1,OPTR);
			MM;
			END
	    ELSE IBP(OPTR);
	    END;
M←MASKBUF≥0;	! MASK? ;
S←SHRINK≠0;	! SHRINK? ;
W←LWTHR>UPTHR;	! WRAP-AROUND? ;

IF M THEN
	BEGIN
	ILIM←ROWS(MASKBUF);
	JLIM←COLMS(MASKBUF);
	IINCR←ISUBST(MASKBUF)-ISUBST(CURBUF);
	JINCR←JSUBST(MASKBUF)-JSUBST(CURBUF);
	GETBUF(ILIM,JLIM,BYTZ,NEWBUF←FNDBUF);
	PUTSUB(ISUBST(MASKBUF),JSUBST(MASKBUF),NEWBUF);
	END
ELSE
	BEGIN
	ILIM←ROWS(CURBUF);
	JLIM←COLMS(CURBUF);
	GETBUF(ILIM,JLIM,BYTZ,NEWBUF←FNDBUF);
	PUTSUB(ISUBST(CURBUF),JSUBST(CURBUF),NEWBUF);
	IINCR←JINCR←0;
	END;

IF S THEN
	BEGIN
	JMIN←10240;
	IMIN←IMAX←JMAX←-1;
	IF M THEN IF W THEN    MSW ELSE   MSNW
	ELSE      IF W THEN   NMSW ELSE  NMSNW
	END
ELSE
	IF M THEN IF W THEN    MNSW ELSE   MNSNW
	ELSE      IF W THEN   NMNSW ELSE  NMNSNW;

IF S THEN
	BEGIN
	SHRINK←SHRINK MAX 0;
	IMIN←(IMIN-SHRINK) MAX 1;
	JMIN←(JMIN-SHRINK) MAX 1;
	IMAX←(IMAX+SHRINK) MIN ILIM;
	JMAX←(JMAX+SHRINK) MIN JLIM;
	NEWBUF←CROP(NEWERBUF←NEWBUF,IMIN,IMAX,JMIN,JMAX);
	FREBUF(NEWERBUF);
	END;


RETURN(NEWBUF);
END "TH";
simple internal integer procedure thrm(integer curbuf,masKbuf,val,maskin,series);
    BEGIN "RM"
    INTEGER K,TEMP,SPBUF,BUF,s1,i1,j1;
    INTEGER ISUBMB,ISUBCB,JSUBMB,JSUBCB;
    STRING TSTR,STR,FILNAM,FILE,FILEXT,OUTEXT,NOTE,TNOTE,INDIC,OUTNAM;
    ilim←(((ISUBMB←isubst(maskbuf))+rows(maskbuf)) min ((ISUBCB←isubst(curbuf))+rows(curbuf)))-(ISUBMB max ISUBCB);

    jlim←(((JSUBMB←jsubst(maskbuf))+colms(maskbuf)) min ((JSUBCB←jsubst(curbuf))+colms(curbuf)))-(JSUBMB max JSUBCB);
    IF series THEN
	    BEGIN "SERIES"
	    IFC FALSE THENC   COMMENT SERIES REMOVED BECAUSE ITS NO LONGER USED;
	    sprmpt("FILE NAME",file);
	    sprmpt("FILE EXT",FILEXT);
	    sprmpt("FILE INDICATORS",indic←"RGBDHSYIQ");
	    sprmpt("OUTPUT FILE NAME",OUTNAM);
	    sprmpt("OUTPUT FILE EXT",OUTEXT);
	    VAL←-1;
	    WHILE TRUE DO
		BEGIN "SERLP"
		TSTR←LOP(INDIC);
		IF NOT TSTR THEN DONE;
		IF TSTR="D" THEN TSTR←NULL;
		FILNAM←FILE&TSTR&"."&FILEXT;
		INDMP("DSK",FILNAM,BUF←FNDBUF,0);
		IINCR←ISUBMB-ISUBST(BUF);
		JINCR←JSUBMB-JSUBST(BUF)+1;
		GETBUF(ILIM,JLIM,BYTSZ(BUF),SPBUF←FNDBUF);
		PUTSUB(ISUBMB,JSUBMB,SPBUF);
		FOR I←1 THRU ILIM DO
		    BEGIN
		    IPTR←INPTR(I+IINCR,JINCR,BUF);
		    MPTR←INPTR(I,1,MASKBUF);
		    OPTR←OUTPTR(I,1,SPBUF);
		    FOR J←1 THRU JLIM DO
			IF ILDB(MPTR) THEN IDPB(ILDB(IPTR),OPTR) 
			    ELSE BEGIN IBP(IPTR); IDPB(VAL,OPTR); END;
		    ROWCHK(CHKROW,ROWS,I,50);
		    END;
		FREBUF(BUF);
		OUTDMP("DSK",OUTNAM&TSTR&"."&OUTEXT,SPBUF,0);
		FREBUF(SPBUF);
		PRINT("JUST PROCESSED FILE: ",FILNAM,CRLF);
		END "SERLP";
	    FREBUF(MASKBUF);
	    ELSEC PRINT("NO SERIES",CRLF);
	    ENDC
	    END "SERIES"
    ELSE begin "NO SERIES"
	    IINCR←(IF ISUBMB>ISUBCB THEN ISUBMB-ISUBCB ELSE 0)+1;
	    JINCR←(IF JSUBMB>JSUBCB THEN JSUBMB-JSUBCB ELSE 0)+1;
	    I1←(IF ISUBCB>ISUBMB THEN ISUBCB-ISUBMB ELSE 0)+1;
	    J1←(IF JSUBCB>JSUBMB THEN JSUBCB-JSUBMB ELSE 0)+1;

	    IF maskin THEN
		    BEGIN "MASK IN"
		    FOR I←1 STEP 1 UNTIL ILIM DO
			BEGIN
			IPTR←INPTR(I+i1-1,j1,MASKBUF);
			OPTR←OUTPTR(I+IINCR-1,JINCR,CURBUF);
			FOR J←1 STEP 1 UNTIL JLIM DO
			    IF ILDB(IPTR) THEN IDPB(VAL,OPTR)
				ELSE IBP(OPTR);
			ROWCHK(CHKROW,ROWS,I,50);
			END;
		    END "MASK IN"
		ELSE BEGIN "MASK OUT"
		    GETBUF((ILIM max 4),(JLIM max 4),BYTSZ(CURBUF),SPBUF←FNDBUF);
		    PUTSUB((ISUBMB MAX ISUBCB),(JSUBMB MAX JSUBCB),SPBUF);
		    FOR I←1 THRU ILIM DO
			BEGIN
			IPTR←INPTR(I+IINCR-1,JINCR,CURBUF);
			MPTR←INPTR(I+i1-1,j1,MASKBUF);
			OPTR←OUTPTR(I,1,SPBUF);
			FOR J←1 THRU JLIM DO
			    IF ILDB(MPTR) THEN IDPB(ILDB(IPTR),OPTR) 
				ELSE BEGIN IBP(IPTR); IDPB(VAL,OPTR); END;
			ROWCHK(CHKROW,ROWS,I,50);
			END;
		    FREBUF(CURBUF);
		    CURBUF←SPBUF;
		    END "MASK OUT";
    END "NO SERIES";
    return(curbuf);
    END "RM";

SIMPLE internal PROCEDURE OVERLAY(INTEGER CURBUF,MASKBUF);
    BEGIN "OVERLAY"
    INTEGER ILIM,JLIM,IPTR,OPTR,IINCR,JINCR,VAL;
    ILIM←ROWS(MASKBUF);
    JLIM←COLMS(MASKBUF);
    IINCR←ISUBST(MASKBUF)-ISUBST(CURBUF);
    JINCR←JSUBST(MASKBUF)-JSUBST(CURBUF)+1;
    FOR I←1 STEP 1 UNTIL ILIM DO
	BEGIN
	IPTR←INPTR(I,1,MASKBUF);
	OPTR←OUTPTR(I+IINCR,JINCR,CURBUF);
	FOR J←1 STEP 1 UNTIL JLIM DO
	    IF VAL←ILDB(IPTR) THEN IDPB(VAL,OPTR)
		ELSE IBP(OPTR);
	ROWCHK(CHKROW,ROWS,I,100);
	END;
    END "OVERLAY";
END "THRESH";